1. Prognosemodel - Retentie na 1 jaar

SWE | B Social Work (SW) - voltijd - versie 1.0

Auteur

Theo Bakker, lector Learning Technology & Analytics, De HHs

Publicatiedatum

19 juni 2024

1 Inleiding

1.1 Het nut van prognosemodellen

Prognosemodellen kunnen inzicht bieden in de factoren die gecorreleerd zijn aan de uitval of - als tegenhanger - de retentie van studenten. Met deze inzichten kan een opleiding interventies ontwikkelen om uitval te verminderen of te voorkomen en retentie te bevorderen.

Het lectoraat Learning Technology & Analytics (LTA) heeft als doel te kunnen analyseren of er sprake is van bias in de data in relatie tot het succes van studenten en er mogelijk sprake is van een gebrek aan kansengelijkheid. Hiervoor zetten we machine learning in. Een prognosemodel is dus niet een doel op zicht, maar het instrument voor een fairness analyse. Zie voor een verdere toelichting het onderzoeksprogramma ‘No Fairness without Awareness’.

Voor de uitleg van de toepassing van deze methode om kansengelijkheid op te sporen is retentie beter te volgen dan uitval. Vandaar dat we in deze analyse de retentie als uitkomstvariabele nemen.

Disclaimer

De modellen die we in deze analyses ontwikkelen zijn bedoeld om de dynamiek in het studiesucces van studenten een opleiding beter te begrijpen om kansengelijkheid en te bevorderen.

Deze modellen mogen op geen enkele wijze gebruikt worden om individuele studenten te beoordelen of hun succes te voorspellen.

1.2 Toelichting op de methode

Voor de ontwikkeling van prognosemodellen gebruiken we de aanpak van Tidymodels. Tidymodels is een framework voor het bouwen van een prognosemodel. Hiermee verzekeren we ons van een systematische, herhaalbare en schaalbare aanpak voor het bouwen van prognosemodellen.

1.3 Toelichting op de data

De basis voor deze analyse is studiedata van De Haagse Hogeschool (De HHs), verrijkt door het lectoraat LTA. De data bevat informatie over de inschrijvingen van studenten in het eerste jaar van de opleiding:

  1. Demografische kenmerken: geslacht, leeftijd, reistijd en SES totaalscore.
  2. Vooropleidingskenmerken: toelaatgevende vooropleiding, studiekeuzeprofiel, gemiddeld eindcijfer in de vooropleiding en eventuele deelname aan het Navitas programma.
  3. Aanmeldingskenmerken: aansluiting (direct na diploma, tussenjaar, switch), dag van aanmelding, aantal parallelle studies aan De HHs en collegejaar.

1.4 Toelichting op de analyse

We toetsen in deze analyse Retentie na 1 jaar, voortaan Retentie genoemd.

Retentie is gedefinieerd als ingeschreven staan in dezelfde opleiding in een aansluitend collegejaar. Een wisseling van opleidingsvorm binnen de opleiding, bijv. van voltijd in jaar 1 naar duaal in jaar 2, geldt ook als retentie.

Uitval is het tegenovergestelde van retentie: niet ingeschreven staan in dezelfde opleiding in een aansluitend collegejaar. Een wisseling van opleidingsvorm binnen de opleiding, bijv. van voltijd in jaar 1 naar duaal in jaar 2, geldt niet als uitval.

2 Voorbereidingen

2.1 Laad de data

We laden een subset in van historische data specifiek voor:

Opleiding: SWE | B Social Work (SW), voltijd, eerstejaars - Retentie na 1 jaar

Toon code 
## Laad de data voor de opleiding
dfOpleiding_inschrijvingen_base <- get_lta_studyprogram_enrollments_pin(
    board = "HHs/Inschrijvingen",
    faculty = faculteit,
    studyprogram = opleidingsnaam_huidig,
    studytrack = opleiding,
    studyform = toupper(opleidingsvorm),
    range = "eerstejaars")

## Herschik de levels
Set_Levels(dfOpleiding_inschrijvingen_base)

dfOpleiding_inschrijvingen_base <- dfOpleiding_inschrijvingen_base |>  
  
  ## Maak een eenvoudige succes variabele aan
  Mutate_Retentie(sSucces_model) |>
  
  ## Maak van de succes variabele een factor
  mutate(SUC_Retentie = as.factor(SUC_Retentie)) |> 

  ## Verbijzonder eventueel op basis van het propedeusediploma
  # Filter_Propedeusediploma(sPropedeusediploma) |>

  ## Maak van de Dubbele studie variabele een Ja/Nee variabele
  mutate(INS_Dubbele_studie = ifelse(INS_Aantal_inschrijvingen > 1, "Ja", "Nee")) |>  

  ## Verwijder INS_Aantal_inschrijvingen
  select(-INS_Aantal_inschrijvingen) |> 

  ## Pas voor een aantal variabelen de levels aan
  Mutate_Levels(
  c(
    "VOP_Studiekeuzeprofiel_LTA_afkorting",
    "INS_Aansluiting_LTA",
    "VOP_Toelaatgevende_vooropleiding_soort"
  ),
    list(lLevels_skp, lLevels_vop, lLevels_vop)
  )
  
## B Huidtherapie: Filter op uitsluitend studenten met een rangnummer (selectie)
if(opleiding == "HDT") {
  dfOpleiding_inschrijvingen_base <- dfOpleiding_inschrijvingen_base |> 
    filter(!is.na(RNK_Rangnummer)) 
}

2.2 Selecteer en inspecteer de data

We selecteren eerst de relevante variabelen. We verwijderen daarbij variabelen die maar 1 waarde hebben. We bekijken de variabelen in een samenvatting in relatie tot retentie. Daarnaast bekijken we de kwaliteit van de data op missende waarden.

Toon code 
lSelect <- c(
    "INS_Student_UUID_opleiding_vorm",
    "CBS_APCG_tf",
    "DEM_Geslacht",
    "DEM_Leeftijd_1_oktober",
    "GIS_Tijd_fiets_OV",
    "INS_Collegejaar",
    "INS_Dagen_tussen_aanmelding_en_1_september",
    "INS_Dubbele_studie",
    "INS_Aansluiting_LTA",
    "INS_Navitas_tf",
    "SES_Deelscore_arbeid",
    "SES_Deelscore_welvaart",
    "SES_Totaalscore",
    "SUC_Retentie",
    "VOP_Gemiddeld_cijfer_cijferlijst",
    "VOP_Gemiddeld_eindcijfer_VO_van_de_hoogste_vooropleiding_voor_het_HO",
    "VOP_Cijfer_CE1_nederlands",
    "VOP_Cijfer_CE1_engels",
    "VOP_Cijfer_CE_proxy_wiskunde",
    "VOP_Cijfer_CE1_natuurkunde",
    "VOP_Studiekeuzeprofiel_LTA_afkorting",
    "VOP_Toelaatgevende_vooropleiding_soort"
  )

## B Huidtherapie: voeg de variabele RNK_Rangnummer toe
if(opleiding == "HDT") {
  lSelect <- c(lSelect, "RNK_Rangnummer")
}

## Maak een subset
dfOpleiding_inschrijvingen <- dfOpleiding_inschrijvingen_base |>
  
  ## Selecteer de relevante variabelen
  select_at(lSelect) |>
  
  ## Hernoem variabelen voor beter leesbare namen
  rename(
    ID                    = INS_Student_UUID_opleiding_vorm,
    Geslacht              = DEM_Geslacht,
    Leeftijd              = DEM_Leeftijd_1_oktober,
    Reistijd              = GIS_Tijd_fiets_OV,
    Dubbele_studie        = INS_Dubbele_studie,
    Collegejaar           = INS_Collegejaar,
    Aanmelding            = INS_Dagen_tussen_aanmelding_en_1_september,
    Aansluiting           = INS_Aansluiting_LTA,
    Navitas               = INS_Navitas_tf,
    APCG                  = CBS_APCG_tf,
    SES_Arbeid            = SES_Deelscore_arbeid,
    SES_Welvaart          = SES_Deelscore_welvaart,
    SES_Totaal            = SES_Totaalscore,          
    Retentie              = SUC_Retentie,
    Cijfer_SE_VO          = VOP_Gemiddeld_cijfer_cijferlijst,
    Cijfer_CE_VO          = VOP_Gemiddeld_eindcijfer_VO_van_de_hoogste_vooropleiding_voor_het_HO,
    Cijfer_CE_Nederlands  = VOP_Cijfer_CE1_nederlands,
    Cijfer_CE_Engels      = VOP_Cijfer_CE1_engels,
    Cijfer_CE_Wiskunde    = VOP_Cijfer_CE_proxy_wiskunde,
    Cijfer_CE_Natuurkunde = VOP_Cijfer_CE1_natuurkunde,
    Studiekeuzeprofiel    = VOP_Studiekeuzeprofiel_LTA_afkorting,
    Vooropleiding         = VOP_Toelaatgevende_vooropleiding_soort
  ) |> 
  
  ## Pas CBS_APCG_tf aan naar factor
  mutate(APCG = case_when(APCG == TRUE ~ "Ja",
                          APCG == FALSE ~ "Nee",
                          .default = "Onbekend")) |>

  ## Geef aan waar missende cijfers in het VO zijn
  Mutate_Cijfers_VO() |>
  
  ## Verwijder variabelen, waarbij er maar 1 waarde is
  select(where(~ n_distinct(.) > 1)) |>
  
  arrange(Collegejaar, ID)

## B Huidtherapie: hernoem de variabele RNK_Rangnummer
if(opleiding == "HDT") {
  dfOpleiding_inschrijvingen <- dfOpleiding_inschrijvingen |> 
    rename(Rangnummer = RNK_Rangnummer)
} 

dfOpleiding_inschrijvingen <- dfOpleiding_inschrijvingen |> 
 ltabase::sort_distinct()

## Verwijder de basis dataset
rm(dfOpleiding_inschrijvingen_base)
Studentkenmerken versus Retentie
Variabele Retentie Totaal, N = 15841
Ja, N=921 (58%)1 Nee, N=663 (42%)1
Aanmelding 135,69 (64,69) 126,91 (66,10) 132,02 (65,40)
Aansluiting


    Overig 0 (0%) 4 (100%) 4 (100%)
    2e Studie 1 (25%) 3 (75%) 4 (100%)
    Direct 445 (59%) 312 (41%) 757 (100%)
    Na CD 37 (65%) 20 (35%) 57 (100%)
    Switch extern 310 (58%) 229 (42%) 539 (100%)
    Switch intern 29 (55%) 24 (45%) 53 (100%)
    Tussenjaar 99 (58%) 71 (42%) 170 (100%)
APCG


    Ja 396 (56%) 305 (44%) 701 (100%)
    Nee 467 (62%) 290 (38%) 757 (100%)
    Onbekend 58 (46%) 68 (54%) 126 (100%)
Cijfer_CE_Engels 6,84 (1,12) 7,05 (1,11) 6,92 (1,12)
Cijfer_CE_Engels_missing


    Ja 681 (56%) 528 (44%) 1.209 (100%)
    Nee 240 (64%) 135 (36%) 375 (100%)
Cijfer_CE_Natuurkunde 5,90 (1,03) 6,18 (0,80) 6,01 (0,94)
Cijfer_CE_Natuurkunde_missing


    Ja 886 (58%) 638 (42%) 1.524 (100%)
    Nee 35 (58%) 25 (42%) 60 (100%)
Cijfer_CE_Nederlands 6,15 (0,88) 6,22 (0,88) 6,18 (0,88)
Cijfer_CE_Nederlands_missing


    Ja 683 (56%) 528 (44%) 1.211 (100%)
    Nee 238 (64%) 135 (36%) 373 (100%)
Cijfer_CE_VO 6,37 (0,35) 6,39 (0,37) 6,38 (0,35)
Cijfer_CE_VO_missing


    Ja 594 (56%) 463 (44%) 1.057 (100%)
    Nee 327 (62%) 200 (38%) 527 (100%)
Cijfer_CE_Wiskunde 6,17 (1,08) 6,09 (1,04) 6,14 (1,07)
Cijfer_CE_Wiskunde_missing


    Ja 720 (57%) 549 (43%) 1.269 (100%)
    Nee 201 (64%) 114 (36%) 315 (100%)
Cijfer_SE_VO 6,38 (0,35) 6,36 (0,36) 6,37 (0,36)
Cijfer_SE_VO_missing


    Ja 637 (56%) 502 (44%) 1.139 (100%)
    Nee 284 (64%) 161 (36%) 445 (100%)
Dubbele_studie


    Ja 5 (15%) 28 (85%) 33 (100%)
    Nee 916 (59%) 635 (41%) 1.551 (100%)
Geslacht


    M 235 (53%) 208 (47%) 443 (100%)
    V 686 (60%) 455 (40%) 1.141 (100%)
Leeftijd 20,67 (2,63) 21,25 (3,15) 20,91 (2,88)
Reistijd 31,28 (17,86) 31,68 (19,27) 31,44 (18,45)
SES_Arbeid -0,04 (0,10) -0,05 (0,10) -0,04 (0,10)
SES_Totaal -0,15 (0,35) -0,17 (0,34) -0,16 (0,35)
SES_Welvaart -0,07 (0,16) -0,08 (0,15) -0,07 (0,16)
Studiekeuzeprofiel


    EM 30 (50%) 30 (50%) 60 (100%)
    CM 89 (63%) 53 (37%) 142 (100%)
    EM&CM 148 (69%) 68 (31%) 216 (100%)
    NT 5 (71%) 2 (29%) 7 (100%)
    NG 57 (56%) 45 (44%) 102 (100%)
    NT&NG 21 (55%) 17 (45%) 38 (100%)
    OS 1 (100%) 0 (0%) 1 (100%)
    ALG 3 (100%) 0 (0%) 3 (100%)
    EA 99 (53%) 88 (47%) 187 (100%)
    HO 32 (58%) 23 (42%) 55 (100%)
    HB 7 (50%) 7 (50%) 14 (100%)
    ICT 8 (67%) 4 (33%) 12 (100%)
    MedV 8 (47%) 9 (53%) 17 (100%)
    TP 1 (33%) 2 (67%) 3 (100%)
    TR 22 (58%) 16 (42%) 38 (100%)
    TSL 11 (61%) 7 (39%) 18 (100%)
    UV 3 (50%) 3 (50%) 6 (100%)
    VS 10 (59%) 7 (41%) 17 (100%)
    VNL 8 (89%) 1 (11%) 9 (100%)
    ZW 264 (57%) 199 (43%) 463 (100%)
Vooropleiding


    MBO 476 (57%) 366 (43%) 842 (100%)
    HAVO 326 (61%) 208 (39%) 534 (100%)
    VWO 25 (78%) 7 (22%) 32 (100%)
    BD 34 (41%) 49 (59%) 83 (100%)
    HO 15 (60%) 10 (40%) 25 (100%)
    CD 44 (67%) 22 (33%) 66 (100%)
    Overig 1 (50%) 1 (50%) 2 (100%)
1 Mean (SD); n (%)
Toon code 
## Laad dlookr
suppressMessages(library(dlookr))

## Toon een samenvatting van de data, gesorteerd op missende waarden
diagnose(dfOpleiding_inschrijvingen) |> 
  mutate(missing_percent = round(missing_percent, 2),
         unique_rate = round(missing_percent, 2)) |>
  arrange(desc(missing_percent)) |>
  knitr::kable(caption = "Kwaliteit van de data voor bewerkingen (gesorteerd op missende waarden)",
               col.names = c("Variabelen",
                           "Type",
                           "# Missende waarden",
                           "% Missende waarden",
                           "# Unieke waarden",
                           "Ratio unieke waarden"))
Kwaliteit van de data voor bewerkingen (gesorteerd op missende waarden)
Variabelen Type # Missende waarden % Missende waarden # Unieke waarden Ratio unieke waarden
Cijfer_CE_Natuurkunde numeric 1524 96.21 34 96.21
Cijfer_CE_Wiskunde numeric 1269 80.11 52 80.11
Cijfer_CE_Nederlands numeric 1211 76.45 47 76.45
Cijfer_CE_Engels numeric 1209 76.33 50 76.33
Cijfer_SE_VO numeric 1139 71.91 21 71.91
Cijfer_CE_VO numeric 1057 66.73 21 66.73
Studiekeuzeprofiel factor 176 11.11 21 11.11
SES_Arbeid numeric 128 8.08 303 8.08
SES_Totaal numeric 128 8.08 540 8.08
SES_Welvaart numeric 128 8.08 408 8.08
Reistijd numeric 18 1.14 343 1.14
Aanmelding numeric 0 0.00 301 0.00
Aansluiting factor 0 0.00 7 0.00
APCG character 0 0.00 3 0.00
Cijfer_CE_Engels_missing character 0 0.00 2 0.00
Cijfer_CE_Natuurkunde_missing character 0 0.00 2 0.00
Cijfer_CE_Nederlands_missing character 0 0.00 2 0.00
Cijfer_CE_VO_missing character 0 0.00 2 0.00
Cijfer_CE_Wiskunde_missing character 0 0.00 2 0.00
Cijfer_SE_VO_missing character 0 0.00 2 0.00
Collegejaar numeric 0 0.00 6 0.00
Dubbele_studie character 0 0.00 2 0.00
Geslacht character 0 0.00 2 0.00
ID character 0 0.00 1584 0.00
Leeftijd integer 0 0.00 21 0.00
Retentie factor 0 0.00 2 0.00
Vooropleiding factor 0 0.00 7 0.00
Toon code 
## Verwijder dlookr
detach("package:dlookr", unload = TRUE)

2.3 Bewerk de data

  • Uit de eerste diagnose blijkt dat niet alle variabelen goed genoeg zijn voor het bouwen van een prognosemodel: er zijn missende waarden en niet alle veldtypes zijn geschikt. We passen de variabelen aan zodat we in het model er goed mee kunnen werken.
  • Prognosemodellen kunnen niet omgaan met missende waarden. Om bias te voorkomen verwijderen we geen rijen met missende waarden, maar vullen die op (imputatie). We bewerken de data zo dat alle missende waarden worden opgevuld: bij numerieke waarden met het gemiddelde en bij categorische variabelen met ‘Onbekend’.
  • We passen sommige variabelen aan, zodat ze in het model gebruikt kunnen worden: tekstvelden zetten we om naar factor (een categorische variabele); logische variabelen (Ja/Nee) zetten we om naar een numerieke variabele (1/0).
  • De uitkomstvariabele, Retentie, leiden we af van de variabele SUC_Uitval_aantal_jaar_LTA. Als de waarde daar 1 is, is de student na 1 jaar uitgevallen, 2 na 2 jaar, etc. Zolang de waarde daar 0 is, is de student niet uitgevallen.
  • Een fictief studentnummer (INS_Student_UUID_opleiding_vorm) gebruiken we, zodat we - als er afwijkende resultaten zijn - de dataset gericht kunnen onderzoeken indien nodig.
Toon code 
## Bewerk de data
dfOpleiding_inschrijvingen <- dfOpleiding_inschrijvingen |> 
  
  ## Imputeer alle numerieke variabelen met de mean
  mutate(across(where(is.numeric), ~ ifelse(
    is.na(.x),
    mean(.x, na.rm = T),
    .x
  )) ) |>
  
  ## Zet character variabelen om naar factor
  mutate(across(where(is.character), as.factor)) |> 
  
  ## Zet logische variabelen om naar 0 of 1
  mutate(across(where(is.logical), as.integer)) |>
  
  ## Vul in factoren missende waarden op met "Onbekend"
  mutate(across(where(is.factor), ~ suppressWarnings(
    fct_explicit_na(.x, na_level = "Onbekend")
  ))) |> 
  
  ## Herschik de kolommen, zodat Retentie vooraan staat
  select(Retentie, everything()) 

## Bekijk de data
## glimpse(dfOpleiding_inschrijvingen) 

## Laad dlookr
suppressMessages(library(dlookr))

## Maak een diagnose van de data
diagnose(dfOpleiding_inschrijvingen) |> 
  mutate(missing_percent = round(missing_percent, 2),
         unique_rate = round(unique_rate, 2)) |>
  knitr::kable(caption = "Kwaliteit van de data na bewerkingen",
               col.names = c("Variabelen",
                           "Type",
                           "# Missende waarden",
                           "% Missende waarden",
                           "# Unieke waarden",
                           "Ratio unieke waarden"))
Kwaliteit van de data na bewerkingen
Variabelen Type # Missende waarden % Missende waarden # Unieke waarden Ratio unieke waarden
Retentie factor 0 0 2 0.00
Aanmelding numeric 0 0 301 0.19
Aansluiting factor 0 0 7 0.00
APCG factor 0 0 3 0.00
Cijfer_CE_Engels numeric 0 0 50 0.03
Cijfer_CE_Engels_missing factor 0 0 2 0.00
Cijfer_CE_Natuurkunde numeric 0 0 34 0.02
Cijfer_CE_Natuurkunde_missing factor 0 0 2 0.00
Cijfer_CE_Nederlands numeric 0 0 47 0.03
Cijfer_CE_Nederlands_missing factor 0 0 2 0.00
Cijfer_CE_VO numeric 0 0 21 0.01
Cijfer_CE_VO_missing factor 0 0 2 0.00
Cijfer_CE_Wiskunde numeric 0 0 52 0.03
Cijfer_CE_Wiskunde_missing factor 0 0 2 0.00
Cijfer_SE_VO numeric 0 0 21 0.01
Cijfer_SE_VO_missing factor 0 0 2 0.00
Collegejaar numeric 0 0 6 0.00
Dubbele_studie factor 0 0 2 0.00
Geslacht factor 0 0 2 0.00
ID factor 0 0 1584 1.00
Leeftijd integer 0 0 21 0.01
Reistijd numeric 0 0 343 0.22
SES_Arbeid numeric 0 0 303 0.19
SES_Totaal numeric 0 0 540 0.34
SES_Welvaart numeric 0 0 408 0.26
Studiekeuzeprofiel factor 0 0 21 0.01
Vooropleiding factor 0 0 7 0.00
Toon code 
detach("package:dlookr", unload = TRUE)

2.4 Bekijk de onderlinge correlaties

Het is verstandig om voorafgaand aan het bouwen van een model te kijken naar de onderlinge correlaties tussen numerieke variabelen. Dit geeft inzicht in de data en kan helpen bij het maken van keuzes voor het model of de duiding van de uitkomsten.

Toon code 
## Maak een plot van de onderlinge correlaties in numerieke variabelen
dfOpleiding_inschrijvingen |> 
  select(-Collegejaar) |>
  select(where(is.numeric)) |> 
  cor() |> 
  corrplot::corrplot(
    order = 'hclust', 
    addrect = 4,
    method = "number",  
    tl.cex = 0.8,       
    tl.col = "black",
    diag = FALSE)

2.5 Bouw de trainingset, validatieset en testset

  • De data is nu geschikt om een prognosemodel mee te bouwen.
  • Om het model te bouwen, testen en valideren, splitsen we de data in drie delen van 60%, 20% en 20%. We doen dit op zo’n manier, dat elk deel ongeveer een gelijk aantal studenten bevat dat doorstudeert (dus niet uitvalt).
  • We trainen het model op basis van 60% en valideren de modellen tijdens het trainen op de overige 20% (de validatieset).
  • De verdeling van de training- en validatieset muteren we 10x (10 folds) om te voorkomen dat het model te veel leert van de trainingset en daardoor slecht presteert op de validatieset.
  • Als het model klaar is, testen we het op de 20% studenten uit de testset. De testset blijft dus de gehele tijd ongemoeid, zodat we overfitting - een te goed model op bekende data, maar slechte presetaties (performance) op onbekende data - voorkomen.
  • Een willekeurig, maar vaststaand seed-getal voorkomt dat we bij elke run van het model c.q. deze code een net iets andere uitkomst krijgen.

Toon code 
set.seed(0821)

## Splits de data in 3 delen: 60%, 20% en 20%
splits      <- initial_validation_split(dfOpleiding_inschrijvingen,
                                        strata = Retentie,
                                        prop = c(0.6, 0.2))

## Maak drie sets: een trainingset, een testset en een validatieset
dfRetentie_train      <- training(splits)
dfRetentie_test       <- testing(splits)
dfRetentie_validation <- validation_set(splits)

## Maak een resample set op basis van 10 folds (default)
dfRetentie_resamples  <- vfold_cv(dfRetentie_train, strata = Retentie)
Verhouding training- en testset
Naam Retentie Aantal Proportie
Trainingset FALSE 397 41.8%
Trainingset TRUE 552 58.2%
Testset FALSE 133 41.8%
Testset TRUE 185 58.2%

3 Model I: Logistische Regressie

  • Het eerste model is een logistische regressie met penalized likelihood; we gebruiken de glmnet engine voor het bouwen van het model. Penalized likelihood is een techniek die helpt bij het voorkomen van overfitting. Glmnet is een populair package voor het bouwen van logistische regressiemodellen.
  • We gebruiken de Area under the ROC Curve (AUC/ROC) als performance metric.

3.1 Maak het model

Eerst bouwen we het model.

## Bouw het model: logistische regressie
lr_mod <- 
  logistic_reg(penalty = tune(), mixture = 1) |> 
  set_engine("glmnet")

3.2 Maak de recipe

Vervolgens zetten we meerdere stappen in een ‘recipe’:

  • We definiëren de student-ID als ID variabele. Daarmee krijgt deze variabele de rol van uniek rij-kenmerk.
  • We verwijderen vervolgens de oorspronkelijke student-ID en het collegejaar uit de data, omdat deze verder niet gebruikt moeten worden in het model.
  • We converteren factoren naar dummy variabelen.
  • We verwijderen variabelen die geen waarde toevoegen: variabelen met enkel nullen.
  • We transformeren numerieke variabelen om ze met elkaar te kunnen vergelijken door ze te centreren en schalen.
  • Sterk gecorreleerde waarden verwijderen we nu niet, omdat we later in de analyse de eventuele samenhang met andere variabelen in een prognosemodel nog willen kunnen visualiseren.
## Bouw de recipe: logistische regressie
lr_recipe <- 
  recipe(Retentie ~ ., data = dfRetentie_train) |>  
  update_role(ID, new_role = "ID") |>           ## Zet de student ID als ID variabele
  step_rm(ID, Collegejaar) |>                   ## Verwijder ID en collegejaar uit het model
  step_dummy(all_nominal_predictors()) |>       ## Maak dummy variabelen van categorische variabelen
  step_zv(all_predictors()) |>                  ## Verwijder zero values
  step_normalize(all_numeric_predictors())      ## Centreer en schaal numerieke variabelen

## Toon de recipe
tidy(lr_recipe) |> 
  knitr::kable(col.names = c("Nummer", 
                             "Operatie", 
                             "Type",
                             "Getraind",
                             "Sla over",
                             "ID"))
Nummer Operatie Type Getraind Sla over ID
1 step rm FALSE FALSE rm_e2xJI
2 step dummy FALSE FALSE dummy_LQcrY
3 step zv FALSE FALSE zv_UTbUo
4 step normalize FALSE FALSE normalize_rdE8q

De variabelen die nu nog resteren zijn:

Resterende variabelen na bewerkingen
Aanmelding Aansluiting_Tussenjaar Studiekeuzeprofiel_HO
Cijfer_CE_Engels APCG_Nee Studiekeuzeprofiel_HB
Cijfer_CE_Natuurkunde APCG_Onbekend Studiekeuzeprofiel_ICT
Cijfer_CE_Nederlands Cijfer_CE_Engels_missing_Nee Studiekeuzeprofiel_MedV
Cijfer_CE_VO Cijfer_CE_Natuurkunde_missing_Nee Studiekeuzeprofiel_TP
Cijfer_CE_Wiskunde Cijfer_CE_Nederlands_missing_Nee Studiekeuzeprofiel_TR
Cijfer_SE_VO Cijfer_CE_VO_missing_Nee Studiekeuzeprofiel_TSL
Leeftijd Cijfer_CE_Wiskunde_missing_Nee Studiekeuzeprofiel_UV
Reistijd Cijfer_SE_VO_missing_Nee Studiekeuzeprofiel_VS
SES_Arbeid Dubbele_studie_Nee Studiekeuzeprofiel_VNL
SES_Totaal Geslacht_V Studiekeuzeprofiel_ZW
SES_Welvaart Studiekeuzeprofiel_CM Studiekeuzeprofiel_Onbekend
Retentie Studiekeuzeprofiel_EM.CM Vooropleiding_HAVO
Aansluiting_X2e.Studie Studiekeuzeprofiel_NT Vooropleiding_VWO
Aansluiting_Direct Studiekeuzeprofiel_NG Vooropleiding_BD
Aansluiting_Na.CD Studiekeuzeprofiel_NT.NG Vooropleiding_HO
Aansluiting_Switch.extern Studiekeuzeprofiel_ALG Vooropleiding_CD
Aansluiting_Switch.intern Studiekeuzeprofiel_EA Vooropleiding_Overig

3.3 Maak de workflow

Voor de uitvoering bouwen we een nieuwe workflow. Daaraan voegen we het model en de bewerkingen in de recipe toe.

## Maak de workflow: logistische regressie
lr_workflow <- 
  workflow() |>         ## Maak een workflow
  add_model(lr_mod) |>  ## Voeg het model toe
  add_recipe(lr_recipe) ## Voeg de recipe toe

## Toon de workflow
lr_workflow
══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: logistic_reg()

── Preprocessor ────────────────────────────────────────────────────────────────
4 Recipe Steps

• step_rm()
• step_dummy()
• step_zv()
• step_normalize()

── Model ───────────────────────────────────────────────────────────────────────
Logistic Regression Model Specification (classification)

Main Arguments:
  penalty = tune()
  mixture = 1

Computational engine: glmnet

3.4 Tune en train het model

Het model moet getuned worden. Dit houdt in dat we de beste parameters voor het model moeten vinden. We maken een grid met verschillende penalty waarden. Daarmee kunnen we vervolgens het beste model selecteren met de hoogste ROC/AUC. We plotten de resultaten van de tuning, zodat we hieruit het beste model kunnen kiezen.

## Maak een grid: logistische regressie
lr_reg_grid <- tibble(penalty = 10 ^ seq(-4, -1, length.out = 30))

## Train en tune het model: logistische regressie
lr_res <- 
  lr_workflow |> 
  tune_grid(dfRetentie_validation,
            grid = lr_reg_grid,
            control = control_grid(save_pred = TRUE),
            metrics = metric_set(roc_auc))
Toon code 
## Plot de resultaten + een rode verticale lijn voor de max AUC
lr_plot <- 
  lr_res |> 
  collect_metrics() |> 
  ggplot(aes(x = penalty, y = mean)) + 
  geom_point() + 
  geom_line() + 
  
  ## Maak de schaal van de x-as logaritmisch
  scale_x_log10(labels = scales::label_number()) +
    theme(
      axis.title.x = element_text(margin = margin(t = 20))
    ) +
  
  # Bepaal de titel, ondertitel en caption
  labs(
    caption = sCaption,
    x = "Area under the ROC Curve",
    y = "Penalty"
  ) +
  
  ## Voeg LTA elementen toe
  Add_LTA_theme_elements(title_subtitle = FALSE)

# Zoek de penalty waarde met de max AUC
max_auc_penalty <- lr_res |> 
  collect_metrics() |> 
  filter(mean == max(mean)) |> 
  pull(penalty)

# Voeg de rode verticale lijn toe aan lr_plot
lr_plot_plus <- lr_plot + 
  geom_vline(xintercept = max_auc_penalty, color = "red")

# Vind een mean voor de max AUC die hoger is
max_auc_mean <- lr_res |> 
  collect_metrics() |> 
  filter(mean == max(mean)) |> 
  pull(penalty)


lr_plot_plus

3.5 Kies het beste model

We evalueren modellen met een zo hoog mogelijke Area under the ROC Curve (AUC/ROC) en een zo laag mogelijke penalty. Zo kunnen we uit de resultaten het beste model kiezen. Tot slot maken we een ROC curve om de prestaties van het model te visualiseren.

## Toon het beste model
top_models <-
  lr_res |> 
  show_best(metric = "roc_auc", n = 10) |> 
  mutate(mean = round(mean, 6)) |>
  arrange(penalty) 

top_models|> 
  knitr::kable(col.names = c("Penalty", 
                             "Metriek", 
                             "Estimator",
                             "Gemiddelde",
                             "Aantal",
                             "SE",
                             "Configuratie"))
Penalty Metriek Estimator Gemiddelde Aantal SE Configuratie
0.0001000 roc_auc binary 0.612210 1 NA Preprocessor1_Model01
0.0001269 roc_auc binary 0.612496 1 NA Preprocessor1_Model02
0.0001610 roc_auc binary 0.612455 1 NA Preprocessor1_Model03
0.0002043 roc_auc binary 0.612455 1 NA Preprocessor1_Model04
0.0002593 roc_auc binary 0.611965 1 NA Preprocessor1_Model05
0.0003290 roc_auc binary 0.610739 1 NA Preprocessor1_Model06
0.0004175 roc_auc binary 0.608982 1 NA Preprocessor1_Model07
0.0005298 roc_auc binary 0.608124 1 NA Preprocessor1_Model08
0.0028072 roc_auc binary 0.606244 1 NA Preprocessor1_Model15
0.0045204 roc_auc binary 0.605713 1 NA Preprocessor1_Model17 
## Selecteer het beste model: logistische regressie
lr_best <- 
  lr_res |> 
  collect_metrics() |> 
  filter(mean == max(mean)) |>
  slice(1) 

lr_best|> 
  mutate(mean = round(mean, 6)) |>
  knitr::kable(col.names = c("Penalty", 
                             "Metriek", 
                             "Estimator",
                             "Gemiddelde",
                             "Aantal",
                             "SE",
                             "Configuratie"))
Penalty Metriek Estimator Gemiddelde Aantal SE Configuratie
0.0001269 roc_auc binary 0.612496 1 NA Preprocessor1_Model02 
## Verzamel de predicties en evalueer het model (AUC/ROC): logistische regressie
lr_auc <- 
  lr_res |> 
  collect_predictions(parameters = lr_best) |> 
  roc_curve(Retentie, .pred_FALSE) |> 
  mutate(model = "Logistisch Regressie")

## Plot de ROC curve
Get_ROC_plot(lr_auc, position = 1)

## Bepaal de AUC van het beste model
lr_auc_highest   <-
  lr_res |>
  collect_predictions(parameters = lr_best) |> 
  roc_auc(Retentie, .pred_FALSE)

## Voeg de naam van het model en de AUC toe dfModel_results
dfModel_results <- 
  dfModel_results |>
  add_row(model = "Logistic Regression", auc = lr_auc_highest$.estimate)

4 Model II: Tree-based ensemble

  • Het tweede model is een random forest: een ensemble van beslisbomen (decision trees). Het is een krachtig model dat goed om kan gaan met complexe data en veel variabelen.
  • We gebruiken de ranger engine voor het bouwen van het model.

4.1 Bepaal het aantal PC-cores

Omdat een random forest model veel berekeningen vereist, willen we daarvoor alle computerkracht gebruiken die beschikbaar is. Het aantal CPU’s (cores) van de computer bepaalt hoe snel het model getraind kan worden. Deze informatie gebruiken we bij het bouwen van het model.

Toon code 
## Bepaal het aantal cores
cores <- parallel::detectCores()

4.2 Maak het model

We bouwen eerst het model. We gebruiken de rand_forest functie om het model te bouwen. We tunen de mtry en min_n parameters. De mtry parameter bepaalt het aantal variabelen dat per boom wordt gebruikt. De min_n parameter bepaalt het minimum aantal observaties dat in een blad van de boom moet zitten. De functie tune() is hier nog een placeholder om de beste waarden voor deze parameters - die we later bepalen - daar in te stellen. We gebruiken 1.000 bomen c.q. versies van het model.

## Bouw het model: random forest

rf_mod <- 
  rand_forest(mtry = tune(), min_n = tune(), trees = 1000) |> 
  set_engine("ranger", num.threads = cores) |> 
  set_mode("classification")

4.3 Maak de recipe

We maken een recipe voor het random forest model. We verwijderen de student ID en het collegejaar uit de data, omdat deze niet moet worden gebruikt in het model. Overige stappen zijn bij een random forest minder relevant in tegenstelling tot een regressiemodel.

## Maak de recipe: random forest
rf_recipe <- 
  recipe(Retentie ~ ., data = dfRetentie_train) |> 
  step_rm(ID, Collegejaar)                      ## Verwijder ID en Collegejaar uit het model
  
## Toon de recipe
tidy(rf_recipe) |> 
  knitr::kable(col.names = c("Nummer", 
                             "Operatie", 
                             "Type",
                             "Getraind",
                             "Sla over",
                             "ID"))
Nummer Operatie Type Getraind Sla over ID
1 step rm FALSE FALSE rm_2JULX

4.4 Maak de workflow

We voegen het model en de recipe toe aan de workflow voor dit model.

## Maak de workflow: random forest
rf_workflow <- 
  workflow() |> 
  add_model(rf_mod) |> 
  add_recipe(rf_recipe)

## Toon de workflow
rf_workflow
══ Workflow ════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: rand_forest()

── Preprocessor ────────────────────────────────────────────────────────────────
1 Recipe Step

• step_rm()

── Model ───────────────────────────────────────────────────────────────────────
Random Forest Model Specification (classification)

Main Arguments:
  mtry = tune()
  trees = 1000
  min_n = tune()

Engine-Specific Arguments:
  num.threads = cores

Computational engine: ranger

4.5 Tune en train het model

We trainen en tunen het model in de workflow. We maken een grid met verschillende waarden voor de parameters mtry en min_n. We gebruiken de Area under the ROC Curve (AUC/ROC) als performance metric. Met de resultaten van de tuning kiezen we het beste model.

## Toon de parameters die getuned kunnen worden
rf_mod
Random Forest Model Specification (classification)

Main Arguments:
  mtry = tune()
  trees = 1000
  min_n = tune()

Engine-Specific Arguments:
  num.threads = cores

Computational engine: ranger 
## Extraheer de parameters die getuned worden
extract_parameter_set_dials(rf_mod)
Collection of 2 parameters for tuning

 identifier  type    object
       mtry  mtry nparam[?]
      min_n min_n nparam[+]

Model parameters needing finalization:
   # Randomly Selected Predictors ('mtry')

See `?dials::finalize` or `?dials::update.parameters` for more information.
## Bepaal de seed
set.seed(2904)

## Bouw het grid: random forest
rf_res <- 
  rf_workflow |> 
  tune_grid(dfRetentie_validation,
            grid = 25,
            control = control_grid(save_pred = TRUE),
            metrics = metric_set(roc_auc))
i Creating pre-processing data to finalize unknown parameter: mtry

4.6 Kies het beste model

We evalueren de beste modellen en maken een ROC curve om de performance van het model te visualiseren. Vervolgens vergelijken we de prestaties van de modellen en kiezen we het beste model.

## Toon de beste modellen
rf_res |> 
  show_best(metric = "roc_auc", n = 15) |> 
  mutate(mean = round(mean, 6)) |>
  knitr::kable(col.names = c("Mtry", 
                             "Min. aantal", 
                             "Metriek",
                             "Estimator",
                             "Gemiddelde",
                             "Aantal",
                             "SE",
                             "Configuratie"))
Mtry Min. aantal Metriek Estimator Gemiddelde Aantal SE Configuratie
2 32 roc_auc binary 0.576700 1 NA Preprocessor1_Model03
2 6 roc_auc binary 0.567342 1 NA Preprocessor1_Model22
3 8 roc_auc binary 0.561417 1 NA Preprocessor1_Model08
4 26 roc_auc binary 0.556514 1 NA Preprocessor1_Model23
5 36 roc_auc binary 0.554062 1 NA Preprocessor1_Model09
7 35 roc_auc binary 0.553898 1 NA Preprocessor1_Model14
8 31 roc_auc binary 0.551978 1 NA Preprocessor1_Model24
6 23 roc_auc binary 0.551201 1 NA Preprocessor1_Model17
16 34 roc_auc binary 0.551161 1 NA Preprocessor1_Model07
18 40 roc_auc binary 0.550997 1 NA Preprocessor1_Model16
17 24 roc_auc binary 0.550221 1 NA Preprocessor1_Model10
22 38 roc_auc binary 0.549608 1 NA Preprocessor1_Model01
11 29 roc_auc binary 0.549403 1 NA Preprocessor1_Model02
15 20 roc_auc binary 0.548096 1 NA Preprocessor1_Model20
11 21 roc_auc binary 0.547769 1 NA Preprocessor1_Model15 
## Plot de resultaten
autoplot(rf_res) +
  theme_minimal() +
  labs(
    y = "roc/auc",
    caption = sCaption
  ) +
  
  ## Voeg LTA elementen toe
  Add_LTA_theme_elements(title_subtitle = FALSE)

## Selecteer het beste model
rf_best <- 
  rf_res |> 
  select_best(metric = "roc_auc")

rf_best|> 
  knitr::kable(col.names = c("Mtry", 
                             "Min. aantal", 
                             "Configuratie"))
Mtry Min. aantal Configuratie
2 32 Preprocessor1_Model03
Toon code 
## Verzamel de predicties
rf_res |> 
  collect_predictions() |> 
  head(10) |>
  mutate(.pred_FALSE = scales::percent(.pred_FALSE, accuracy = 0.1),
         .pred_TRUE = scales::percent(.pred_TRUE, accuracy = 0.1)) |>
  knitr::kable(col.names = c("% Voorsp. FALSE", 
                             "% Voorsp. TRUE", 
                             "ID",
                             "Rij",
                             "Mtry", 
                             "Min. aantal", 
                             "Retentie",
                             "Configuratie"))
% Voorsp. FALSE % Voorsp. TRUE ID Rij Mtry Min. aantal Retentie Configuratie
40.8% 59.2% validation 950 22 38 TRUE Preprocessor1_Model01
36.1% 63.9% validation 951 22 38 FALSE Preprocessor1_Model01
34.0% 66.0% validation 952 22 38 TRUE Preprocessor1_Model01
38.2% 61.8% validation 953 22 38 FALSE Preprocessor1_Model01
45.1% 54.9% validation 954 22 38 FALSE Preprocessor1_Model01
18.5% 81.5% validation 955 22 38 TRUE Preprocessor1_Model01
74.4% 25.6% validation 956 22 38 FALSE Preprocessor1_Model01
48.5% 51.5% validation 957 22 38 FALSE Preprocessor1_Model01
22.8% 77.2% validation 958 22 38 TRUE Preprocessor1_Model01
21.1% 78.9% validation 959 22 38 TRUE Preprocessor1_Model01
Toon code 
## Bepaal de AUC/ROC curve
rf_auc <- 
  rf_res |> 
  collect_predictions(parameters = rf_best) |> 
  roc_curve(Retentie, .pred_FALSE) |> 
  mutate(model = "Random Forest")

## Plot de ROC curve
Get_ROC_plot(rf_auc, position = 2)

Toon code 
## Bepaal de AUC van het beste model
rf_auc_highest   <-
  rf_res |>
  collect_predictions(parameters = rf_best) |> 
  roc_auc(Retentie, .pred_FALSE)

## Voeg de naam van het model en de AUC toe dfModel_results
dfModel_results <- 
  dfModel_results |>
  add_row(model = "Random Forest", auc = rf_auc_highest$.estimate)

5 De uiteindelijke fit

  • In de laatste stap van deze analyse maken we het model definitief.
  • We testen het model op de testset en evalueren het model met metrieken en de Variable Importance Factor (VIF).

5.1 Combineer de AUC/ROC curves en kies het beste model

Eerst combineren we de AUC/ROC curves van de modellen om ze te vergelijken. We kiezen het beste model op basis van de hoogste AUC/ROC.

Toon code 
## Combineer de AUC/ROC curves om de modellen te vergelijken
Get_ROC_plot(list(lr_auc, rf_auc))

Toon code 
## Bepaal welke van de modellen het beste is op basis van de hoogste AUC/ROC
dfModel_results <- dfModel_results |>
  mutate(number = row_number()) |> 
  mutate(best = ifelse(auc == max(auc), TRUE, FALSE)) |> 
  arrange(number)

## Bepaal het beste model
sBest_model     <- dfModel_results$model[dfModel_results$best == TRUE]
sBest_model_auc <- round(dfModel_results$auc[dfModel_results$best == TRUE], 4)

Het beste model is het Logistic Regression model met een AUC/ROC van 0.6125. Het Logistic Regression model heeft een AUC van 0.6125. Het Random Forest model heeft een AUC van 0.5767. We ronden de analyse verder af met het Logistic Regression model.

5.2 Maak het finale model

We maken het finale model op basis van de beste parameters die we hebben gevonden. Door in de engine bij importance de impurity op te geven, wordt het beste random forest model gekozen om de data definitief mee te classificeren.

## Test het ontwikkelde model op de testset
## Bepaal de optimale parameters

## Bouw de laatste modellen
last_lr_mod <-
    logistic_reg(penalty = lr_best$penalty,
                 mixture = 1) |>
    set_engine("glmnet") |>
    set_mode("classification")

last_rf_mod <-
    rand_forest(mtry = rf_best$mtry,
                min_n = rf_best$min_n,
                trees = 1000) |>
    set_engine("ranger", num.threads = cores, importance = "impurity") |>
    set_mode("classification")

5.3 Maak de workflow

We voegen het model toe aan de workflow en updaten de workflow met het finale model.

## Update de workflows
 last_lr_workflow <- 
    lr_workflow |> 
    update_model(last_lr_mod)

 last_rf_workflow <- 
    rf_workflow |> 
    update_model(last_rf_mod)

5.4 Fit het finale model

We voeren de finale fit uit. De functie last_fit past het model toe op de validatieset.

## Voer de laatste fit uit
set.seed(2904)

## Maak voor beide modellen een laatste fit, zodat we deze kunnen opslaan voor later gebruik
last_fit_lr <- 
    last_lr_workflow |> 
    last_fit(splits)

last_fit_rf <- 
    last_rf_workflow |> 
    last_fit(splits)

lLast_fits <- list(last_fit_lr, last_fit_rf) |> 
  set_names(c("Logistic Regression", "Random Forest"))

## Bepaal welk model het beste is
if(sBest_model == "Logistic Regression") {
  last_fit <- last_fit_lr
} else if(sBest_model == "Random Forest") {
  last_fit <- last_fit_rf
}

## Bewaar de resultaten, de modelresultaten en de bijbehorende data
sFittedmodels_outputpath <- Get_Model_outputpath(mode = "last-fits")
saveRDS(lLast_fits, file = sFittedmodels_outputpath)

sModelresults_outputpath <- Get_Model_outputpath(mode = "modelresults")
saveRDS(dfModel_results, file = sModelresults_outputpath)

sData_outputpath <- Get_Model_outputpath(mode = "data")
saveRDS(dfOpleiding_inschrijvingen, file = sData_outputpath)

5.5 Evalueer het finale model: metrieken en vif

We evalueren het finale model op basis van 4 metrieken: 1) accuraatheid, 2) ROC/AUC en 3) de Brier score (de Mean Squared Error) en 4) de Variable Importance Factor (VIF). Uit de VIF is op te maken welke variabelen het meest bijdragen aan de voorspelling van de uitkomstvariabele.

## Verzamel de metrieken
last_fit |> 
  collect_metrics() |> 
  mutate(.estimate = round(.estimate, 4)) |>
  knitr::kable(col.names = c("Metriek", 
                             "Estimator",
                             "Estimate",
                             "Configuratie"))
Metriek Estimator Estimate Configuratie
accuracy binary 0.5912 Preprocessor1_Model1
roc_auc binary 0.5481 Preprocessor1_Model1
brier_class binary 0.2550 Preprocessor1_Model1
Toon code 
# Extraheer de feature importance
dfVif <- last_fit |>
  extract_fit_parsnip() |>
  vip::vi() |> 
  arrange(desc(Importance)) |>
  head(20)
  
# Maak de plot met fill op de variabele 'Importance'
importance_plot <- dfVif |> 
  ggplot(aes(x = reorder(Variable, Importance), 
             y = Importance, 
             fill = Importance)) +
  geom_col(show.legend = FALSE) +
  
  ## Maak de titel en caption
  labs(title = "Meest voorspellende factoren",
       subtitle = "Op basis van de Variable Importance Factor (VIF)",
       x = NULL,
       y = "VIF-score",
       caption = sCaption) +
  
  theme_minimal() +
  Set_LTA_Theme() +
  
  theme(
    axis.title.x = element_text(margin = margin(t = 20))
  ) +
  
  coord_flip() +
  
  ## Voeg LTA elementen toe
  Add_LTA_theme_elements(title_subtitle = TRUE)

# Toon de plot
print(importance_plot)

5.6 Plot de ROC curve

Tot slot maken we een ROC curve om de prestaties van het definitieve model te visualiseren. De Sensitivity (True Positive Rate) en Specificity (True Negative Rate) worden hierin uitgezet. De Area under the ROC Curve (AUC/ROC) geeft de prestaties van het model weer. Het model scoort beter naarmate de AUC/ROC dichter bij de 1 ligt, de linker bovenhoek. De linker bovenhoek houdt in dat alle prognoses exact overeenstemmen met de werkelijkheid. Een AUC/ROC van 0,5 betekent dat het model niet beter presteert dan een willekeurige voorspelling.

## Toon de roc curve
auc_lf <- last_fit |> 
  collect_predictions() |> 
  roc_curve(Retentie, .pred_FALSE) |> 
  mutate(model = "Last fit")

Get_ROC_plot(auc_lf, position = 3)

6 Conclusies

6.1 Het beste prognosemodel voor deze opleiding

Het beste prognosemodel blijkt het Logistic Regression model te zijn.

  • Van de prognosemodellen die we hebben ontwikkeld om retentie na 1 jaar te voorspellen, had het Logistic Regression model de hoogste AUC/ROC waarde (0.6125).

6.2 Mate van accuraatheid en lift

Een prognosemodel moet minimaal beter presteren dan een base-model om waarde op accuraatheid toe te voegen. Het base-model neemt de grootste klasse van de gemiddelde retentie na 1 jaar van de afgelopen jaren als basis. Stel we zouden tegen alle studenten zeggen dat ze hun studie gaan halen, dan is de mate van accuratesse gelijk aan dit base-model. Dit base-model is dus altijd hoger dan de 50% lijn van de AUC/ROC curve, tenzij het base-model toevallig precies 50% is.

De mate van accuraatheid van de toepassing van het model is laag (59.12%).

  • Base-model: 58.14% – Voor deze opleiding bereken we het base-model als volgt. Van alle studenten studeerde 58.14% door. De grootste klasse (en de accuratesse) van het base-model is daarmee (100% - 58.14% = ) 58.14% die doorstudeerde.
  • Accuratesse prognose: 59.12% – Het model voorspelt Retentie na 1 jaar met een accuratesse van 59.12%.
  • Lift: 0.98% – Het model scoort in de huidige opbouw met een verschil van 0.98% (de lift) iets beter dan de accuraatheid van het base-model (58.14%).

6.3 Confusion Matrix

Toon code 
## Bepaal de confusion matrix
confusion_matrix <- last_fit |>
  collect_predictions() |>
  conf_mat(truth = Retentie, estimate = .pred_class) 

dfConf_matrix <- as_tibble(confusion_matrix$table) |>
  rename(Werkelijkheid = Truth) |>
  mutate(Werkelijkheid = ifelse(Werkelijkheid == "TRUE", "Retentie", "Geen retentie"),
         Prediction    = ifelse(Prediction == "TRUE", "Retentie", "Geen retentie"))

pTP <- Number_to_readable((dfConf_matrix$n[4]/sum(dfConf_matrix$n)*100),1)
pFP <- Number_to_readable((dfConf_matrix$n[2]/sum(dfConf_matrix$n)*100),1)
pTN <- Number_to_readable((dfConf_matrix$n[1]/sum(dfConf_matrix$n)*100),1)
pFN <- Number_to_readable((dfConf_matrix$n[3]/sum(dfConf_matrix$n)*100),1)
pACC <- Number_to_readable(Last_fit_Accuracy,1)

De prestaties van het model kunnen we verder uitdrukken in een confusion matrix. Hierin zien we de voorspellingen van het model en de werkelijke uitkomsten. De matrix geeft inzicht in de mate van correcte en incorrecte voorspellingen. Ter illustratie werken we de matrix uit voor een voorspelling waarop een bindend studieadvies (BSA) gebaseerd zou kunnen zijn.

We passen de confusion matrix nu toe op het model dat als beste naar voren kwam. De accuraatheid van dit model is 59,1%. De accuraatheid van het model berekenen we door de som van de diagonaal te berekenen: het aandeel goed voorspelde uitkomsten, Retentie = Retentie (True Positive) en Geen retentie = Geen retentie (True Negative), af te zetten tegen het totaal aantal voorspellingen: 45,6% + 13,5% = 59,1%. (NB. De weergave in deze confusion matrix is diagonaal gespiegeld vergeleken met het voorbeeld.)

Toon code 
plot_confusion_matrix(dfConf_matrix, 
                      target_col = "Werkelijkheid", 
                      prediction_col = "Prediction",
                      counts_col = "n",
                      palette = "Blues",
                      add_sums = TRUE,
                      theme_fn = ggplot2::theme_light,
                      sums_settings = sum_tile_settings(
                        palette = "Greens",
                        label = "Totaal",
                        tc_tile_border_color = "black"
                      )) +
  ## Pas de labels aan
  labs(title = "Confusion Matrix",
       x = "Werkelijke uitkost",
       y = "Voorspelde uitkomst",
       caption = sCaption) +
  
  Set_LTA_Theme() +
  
  ## Voeg LTA elementen toe
  Add_LTA_theme_elements(title_subtitle = TRUE)

6.4 Uitleggen of verklaren?

Naast de accuraatheid van het model is het ook belangrijk om te weten welke factoren het meest bijdragen aan de voorspelling van retentie na 1 jaar. Daarin gaat de vergelijking met de prestaties van het basemodel mank. Dat model geeft op geen enkele manier aan waarom een student een kans op succes heeft, anders dan - ‘dit is gebruikelijk in deze opleiding’.

Ongeacht de mate van accuraatheid, is het voor ons onderzoek naar kansengelijkheid essentieel om te weten welke factoren het meest bijdragen aan de voorspelling van retentie na 1 jaar. Het gaat erom dat we het belang van de factoren in de voorspellingen kunnen begrijpen en duiden. Machine Learning is hiervoor uitstekend geschikt, omdat het de mogelijkheid biedt om de belangrijkste factoren en hun invloed te leren kennen (Shmueli, 2010; Shmueli & Koppius, 2011).

7 Vervolgstappen: Factoranalyse

De volgende stap (stap 2) is een verdiepende analyse van de mate waarin de factoren die we gevonden hebben van invloed zijn op Retentie na 1 jaar. We kijken naar de rangorde, of ze die doorstudeerde verhogen of juist verlagen en hoe stabiel de factoren zijn als we in andere volgordes aan het model toevoegen. Om het concreet te maken zullen we het model toepassen op een aantal fictieve studenten, die we opbouwen uit de meeste voorkomende waarden in deze opleiding. Dit is het onderwerp van analyse 2: de Factoranalyse.

Literatuur

Shmueli, G. (2010). To Explain or to Predict? Statistical Science, 25(3), 289–310. https://doi.org/10.1214/10-sts330
Shmueli, G., & Koppius, O. (2011). Predictive Analytics in Information Systems Research. MIS Quarterly, 35(3), 553. https://doi.org/10.2307/23042796

 

Verantwoording

Deze analyse maakt deel uit van het onderzoek naar kansengelijkheid van het lectoraat Learning Technology & Analytics van De Haagse Hogeschool: No Fairness without Awareness | Het rapport is door het lectoraat ontwikkeld in Quarto 1.4.549. | Template versie: 0.9.1.9000

 

Copyright

Dr. Theo Bakker, Lectoraat Learning Technology & Analytics, De Haagse Hogeschool © 2023-2024. Alle rechten voorbehouden.